home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 2
/
SPACE - Library 2 - Volume 1.iso
/
program
/
561
/
prolog
/
booter.toy
< prev
next >
Wrap
Text File
|
1991-09-08
|
12KB
|
230 lines
% % % translator of Prolog-10 (mini) into TOY Prolog % % %
transl(:0, :1) : see(:0) . tell(:1) . program . seen . told .
see(user) . tell(user) . display(translated(:0)) . nl . []
%% 0 from_file, 1 to_file
% - - - - - - - - - - - - - - - - - - - - - -
% main loop
program : rch . skpb(:0) . tag(transl(:0)) . isendsym(:0) . ! . []
program : program . []
transl('#') : ! . rch . []
transl('%') : comment('%', :0, []) . ! . puttr(:0) . []
transl(:0) : clause(:0, :1, [], :2) . puttr(:1) . putvarnames(:2, 0) . []
%% 0 startch, 1 termrepr, 2 sym_tab
isendsym('#') : [] % otherwise fail, i.e. loop
% - - - - - - - - - - - - - - - - - - - - - -
% error handling: skip to the nearest dot
err(:0, :1) : display('*** error in ') . display(:0) .
display(': unexpected "') . display(:1) . lastch(:2) .
display('". text skipped: ') . b_skip(:2) . nl . tagfail(transl(_)) . []
%% 0 proc_name, 1 bad_item, 2 first_skipped_char
b_skip('.') : wch('.') . []
b_skip(:0) : wch(:0) . rch . lastch(:1) . b_skip(:1) . []
% - - - - - - - - - - - - - - - - - - - - - -
% a comment extends till end_of_line
comment(:0, :0.:1, :1) : iseoln(:0) . []
%% 0 eoln, 1 rest_of_termrepr
comment(:0, :0.:1, :2) : rch . lastch(:3) . comment(:3, :1, :2) . []
%% 0 char, 1 termrepr, 2 rest_of_termrepr, 3 nextchar
% - - - - - - - - - - - - - - - - - - - - - -
% read a goal
clause(':', ':'.:0, :1, :2) : ! . ctail(':', :0, ' '.'#'.:1, :2) . []
%% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab
% read an assertion/rule
clause(:0, :1, :2, :3) : fterm(:0, :4, :1, ' '.':'.:5, :3) .
! . ctail(:4, :5, :2, :3) . []
%% 0 fterm_firstch, 1 termrepr, 2 rest_of_termrepr,
%% 3 sym_tab, 4 ctail_firstch, 5 middletermrepr
clause(:0, _, _, _) : err(clause, :0) . []
% - - - - - - - - - - - - - - - - - - - - - -
% clause tail
ctail('.', ' '.'['.']'.:0, :0, _) : ! . []
%% 0 rest_of_termrepr
% righthand side of a non-unit clause, or a goal
% eoln and blanks inserted to make the output look tidy
ctail(':', :4.' '.' '.' '.:0, :1, :2) : rdch('-') . ! . iseoln(:4) .
rdchsk(:3) . ctailaux(:3, :0, :1, :2) . []
%% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 calls_firstch,
%% 4 eoln
ctail(:0, _, _, _) : err(ctail, :0) . []
% get the righthand side of a clause (embedded comments will not be displaced)
ctailaux('%', :0, :1, :2) : comment('%', :0, ' '.' '.' '.:5) . ! .
rdchsk(:3) . ctailaux(:3, :5, :1, :2) . []
%% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 rest_firstch,
%% 5 middletermrepr
ctailaux(:0, :1, :2, :3) : fterm(:0, :4, :1, ' '.'.'.:5, :3) .
fterms(:4, :5, :2, :3) . []
%% 0 fterm_firstch, 1 termrepr, 2 rest_of_termrepr,
%% 3 sym_tab, 4 fterms_firstch, 5 middletermrepr
% a list of functor-terms (i.e. calls)
fterms('.', ' '.'['.']'.:0, :0, _) : ! . []
%% 0 rest_of_termrepr
% eoln and blanks - cf. ctail/2/
fterms(',', :4.' '.' '.' '.:0, :1, :2) : ! . iseoln(:4) .
rdchsk(:3) . ctailaux(:3, :0, :1, :2) . []
%% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 ctail_firstch,
%% 4 eoln
fterms(:0, _, _, _) : err(fterms, :0) . []
% - - - - - - - - - - - - - - - - - - - - - -
% a functor-term
fterm(:0, :1, ''''.:2, :3, :4) :
ident(:0, :5, :2, ''''.:6) . ! . args(:5, :1, :6, :3, :4) . []
%% 0 id_firstch, 1 terminator, 2 termrepr, 3 rest_of_termrepr,
%% 4 sym_tab, 5 id_terminator, 6 middletermrepr
% identifiers: words, !, quoted names, symbols
ident(:0, :1, :0.:2, :3) :
word_start(:0) . rdch(:4) . alphanums(:4, :1, :2, :3) . []
%% 0 id_firstch, 1 terminator, 2 termrepr,
%% 3 rest_of_termrepr, 4 nextch
ident('!', :0, '!'.:1, :1) : rch . skpb(:0) . []
%% 0 terminator, 1 termrepr
ident('''', :0, :1, :2) : rdch(:3) . qident(:3, :0, :1, :2) . []
%% 0 terminator, 1 termrepr, 2 rest_of_termrepr, 3 nextch
ident(:0, :1, :0.:2, :3) :
symch(:0) . rdch(:4) . symbol(:4, :1, :2, :3) . []
%% 0 symb_firstch, 1 terminator, 2 termrepr,
%% 3 rest_of_termrepr, 4 nextch
% quoted identifiers
qident('''', :0, :1, :2) :
rdch(:3) . qidentail(:3, :0, :1, :2) . ! . []
%% 0 terminator, 1 termrepr, 2 rest_of_termrepr, 3 nextch
qident(:0, :1, :0.:2, :3) : rdch(:4) . qident(:4, :1, :2, :3) . []
%% 0 char, 1 terminator, 2 termrepr,
%% 3 rest_of_termrepr, 4 nextch
qidentail('''', :0, ''''.''''.:1, :2) :
rdch(:3) . qident(:3, :0, :1, :2) . []
%% 0 terminator, 1 termrepr, 2 rest_of_termrepr, 3 nextch
qidentail(_, :0, :1, :1) : skpb(:0) . []
%% 0 terminator, 1 rest_of_termrepr
% words and symbols
alphanums(:0, :1, :0.:2, :3) :
alphanum(:0) . ! . rdch(:4) . alphanums(:4, :1, :2, :3) . []
%% 0 an_alphanum, 1 terminator, 2 termrepr,
%% 3 rest_of_termrepr, 4 nextch
alphanums(_, :0, :1, :1) : skpb(:0) . []
%% 0 terminator, 1 rest_of_termrepr
symbol(:0, :1, :0.:2, :3) :
symch(:0) . ! . rdch(:4) . symbol(:4, :1, :2, :3) . []
%% 0 a_symbolchar, 1 terminator, 2 termrepr,
%% 3 rest_of_termrepr, 4 nextch
symbol(_, :0, :1, :1) : skpb(:0) . []
%% 0 terminator, 1 rest_of_termrepr
% get argument list: nothing or a sequence of terms in round brackets
args('(', :0, '('.:1, :2, :3) :
! . rdchsk(:4) . terms(:4, :1, :2, :3) . rdchsk(:0) . []
%% 0 nextch, 1 termrepr, 2 rest_of_termrepr,
%% 3 sym_tab, 4 terms_firstch
args(:0, :0, :1, :1, _) : []
%% 0 nextch, 1 rest_of_termrepr
% get a sequence of terms
terms(:0, :1, :2, :3) : term(:0, :4, :1, :5, inargs, :3) .
termstail(:4, :5, :2, :3) . []
%% 0 term_firstch, 1 termrepr, 2 rest_of_termrepr, 3 sym_tab,
%% 4 terminator, 5 middletermrepr
termstail(')', ')'.:0, :0, _) : ! . []
%% 0 rest_of_termrepr
termstail(',', ','.' '.:0, :1, :2) :
! . rdchsk(:3) . terms(:3, :0, :1, :2) . []
%% 0 middletermrepr, 1 rest_of_termrepr, 2 sym_tab, 3 nextch
termstail(:0, _, _, _) : err(termstail, :0) . []
% - - - - - - - - - - - - - - - - - - - - - -
% get a term (context used to force brackets around lists within lists)
term(:0, :1, :2, :3, :4, :5) : t(:0, :1, :2, :3, :4, :5) . ! . []
%% 0 firstch, 1 terminator, 2 termrepr,
%% 3 rest_of_termrepr, 4 context, 5 sym_tab
term(:0, _, _, _, _, _) : err(term, :0) . []
t(:0, :1, :2, :3, _, :4) : variable(:0, :1, :2, :3, :4) . []
t(:0, :1, :2, :3, inargs, :4) : list(:0, :1, :2, :3, :4) . []
t(:0, :1, '('.:2, :3, inlist, :4) : list(:0, :1, :2, ')'.:3, :4) . []
% a dirty patch for negative numbers
t('-', :0, :1, :2, _, :3) :
rdch(:4) . numberorfterm(:4, :0, :1, :2, :3) . []
%% 0 terminator, 1 termrepr, 2 rest_of_termrepr,
%% 3 sym_tab, 4 nextch
t(:0, :1, :2, :3, _, _) : number(:0, :1, :2, :3) . []
t(:0, :1, :2, :3, _, :4) : fterm(:0, :1, :2, :3, :4) . []
% - - - - - - - - - - - - - - - - - - - - - -
numberorfterm(:0, :1, '-'.:2, :3, _) :
digit(:0) . ! . number(:0, :1, :2, :3) . []
%% 0 nextch, 1 terminator, 2 termrepr, 3 rest_of_termrepr
numberorfterm(:0, :1, ''''.'-'.:2, :3, :4) :
symbol(:0, :5, :2, ''''.:6) . args(:5, :1, :6, :3, :4) . []
%% 0 nextch, 1 terminator, 2 termrepr, 3 rest_of_termrepr,
%% 4 sym_tab, 5 symbol_terminator, 6 middletermrepr
% - - - - - - - - - - - - - - - - - - - - - -
% get a variable
variable(:0, :1, :2, :3, :4) : var_start(:0) . alphanums(:0, :1, :5, []) .
findv(:5, :2, :3, :4) . ! . []
%% 0 firstch, 1 terminator, 2 termrepr,
%% rest_of_termrepr, 4 sym_tab, 5 name
findv('_'.[], '_'.:0, :0, _) : [] % no search: an anonymous variable
%% 0 rest_of_termrepr
findv(:0, ':'.:1, :2, :3) : look(:0, 0, :4, :3) . setn(:4, :1, :2) . []
%% 0 name, 1 termrepr, 2 rest_of_termrepr, 3 sym_tab, 4 num
% look always counts from 0 and finds the position of a name in the symtab
look(:0, :1, :1, :0.:2) : []
%% 0 name, 1 num, 2 symtabtail
look(:0, :2, :1, _.:3) : sum(:2, 1, :4) . look(:0, :4, :1, :3) . []
%% 0 name, 1 num, 2 currnum, 3 symtabtail, 4 currnumplus1
% set a number: no more than two digits (should be enough)
setn(:0, :1.:2, :2) : less(:0, 10) .
ordchr(:3, '0') . sum(:3, :0, :4) . ordchr(:4, :1) . []
%% 0 num, 1 char, 2 rest_of_termrepr, 3 k, 4 kplusnum
setn(:0, :1, :2) : less(:0, 100) . prod(10, :3, :4, :0) .
setn(:3, :1, :5) . setn(:4, :5, :2) . []
%% 0 num, 1 termrepr, 2 rest_of_termrepr,
%% 3 numby10, 4 nummod10, 5 middletermrepr
setn(:0, _, _) : err(setn, :0) . []
% - - - - - - - - - - - - - - - - - - - - - -
% get a list in square brackets
list('[', :0, :1, :2, :3) : rdchsk(:4) . endlist(:4, :1, :2, :3) .
rdchsk(:0) . []
%% 0 terminator, 1 termrepr, 2 rest_of_termrepr,
%% 3 sym_tab, 4 nextch
endlist(']', '['.']'.:0, :0, _) : []
%% 0 rest_of_termrepr
endlist(:0, :1, :2, :3) :
term(:0, :4, :1, '.'.:5, inlist, :3) . ltail(:4, :5, :2, :3) . []
%% 0 firstch, 1 termrepr, 2 rest_of_termrepr,
%% 3 sym_tab, 4 nextch, 5 middletermrepr
ltail(']', '['.']'.:0, :0, _) : ! . []
%% 0 rest_of_termrepr
ltail('|', :0, :1, :2) : ! . rdchsk(:3) . variable(:3, ']', :0, :1, :2) . []
%% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 nextch
ltail(',', :0, :1, :2) : ! . rdchsk(:3) .
term(:3, :4, :0, '.'.:5, inlist, :2) . ltail(:4, :5, :1, :2) . []
%% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab,
%% 3 term_firstch, 4 nextch, 5 middletermrepr
ltail(:0, _, _, _) : err(ltail, :0) . []
% - - - - - - - - - - - - - - - - - - - - - -
% numbers: only natural ones
number(:0, :1, :2, :3) : digit(:0) . digits(:0, :1, :2, :3) . []
%% 0 firstch, 1 non_digit, 2 termrepr, 3 rest_of_termrepr
digits(:0, :1, :0.:2, :3) : digit(:0) .
! . rdch(:4) . digits(:4, :1, :2, :3) . []
%% 0 firstch, 1 non_digit, 2 termrepr, 3 rest_of_termrepr,
%% 4 nextch
digits(_, :0, :1, :1) : skpb(:0) . []
%% 0 non_digit, 1 rest_of_termrepr
% - - - - - - - - - - - - - - - - - - - - - -
% auxiliary tests
word_start(:0) : smalletter(:0) . []
var_start(:0) : bigletter(:0) . []
var_start('_') : []
% - - - - - - - - - - - - - - - - - - - - - -
skpb(:0) : skipbl . lastch(:0) . []
% - - - - - - - - - - - - - - - - - - - - - -
% output the translation
puttr([]) : ! . []
puttr(:0.:1) : wch(:0) . puttr(:1) . []
putvarnames(:0, _) : var(:0) . ! . nl . []
%% 0 sym_tab_end
putvarnames(:0.:1, :2) : next_line(:2) . wch(' ') . display(:2) . puttr(' '.:0) .
wch(',') . sum(:2, 1, :3) . putvarnames(:1, :3) . []
%% 0 currname, 1 sym_tab_tail, 2 currnum, 3 nextnum
next_line(:0) : prod(6, _, 0, :0) . ! . nl . display(' %%') . []
%% 0 a_multiple_of_line_size
next_line(_) : []
% % % the end % % %
: display('"BOOTSTRAPPER" loaded.') . nl . seen . [] #